home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_oth / tpcalc / tpcalc.pro
Text File  |  1986-06-09  |  9KB  |  365 lines
  1. /*                        TPCALC.PRO                     */
  2. /*       Copyright Craig Fleming, 1986.  Rights granted for all         */
  3. /*     not-for-profit usage and distribution.                */
  4.  
  5. /*    This Program takes advantage of the scratchpad memory routines 
  6.    introduced in SCRTCH.PRO to implement a four register RPN calculator.
  7.    RPN is Reverse Polish  Notation (of course), the same scheme used for HP 
  8.   Calculators.  Operations  are performed on a four register stack.  There 
  9.   is also a fifth stack (not shown) which captures entries popped out of
  10.   stack  four, and pushes them back again when the register stacks drop.
  11.     Total time to implement the calculator was about 4 hours, so it
  12.   may not be as elegant as possible.  Even so it provides an impressive
  13.   display of Turbo Prolog's power.  Improvements and Enhancements are
  14.   encouraged.  For example,  add macro programming capabilities to attach
  15.   special function key definitions.
  16.       A word of philosophy:  Prolog's real power lies in its symbolic
  17.   processing capabilities.  If you want to calculate heat flux across
  18.   a pipe with liquid flowing through it -- choose Fortran or Pascal.
  19.   It's just nice to know that you can crunch numbers if and when the
  20.   need arises.  By the way Jerrold Kaplan of Lotus Development (quoted
  21.   in Byte 5/86) argues that spreadsheets are actually "object oriented
  22.   declarative programming languages".  Interesting.            */
  23.  
  24.  
  25.  
  26. domains
  27.     name  = symbol
  28.  
  29. database
  30.     sp(name,real)                      
  31.       
  32. predicates
  33.         /* The basic scratchpad memory routines.  Their names
  34.            describe their functions.                */ 
  35.     remember(name,real)
  36.     recall(name,real)
  37.     forget(name)        
  38.     replace(name,real)
  39.  
  40.         /* The calculator engine */
  41.     process
  42.     action(real,string,string)
  43.     start
  44.  
  45.         /* Various Utilities     */
  46.     set_up_calc
  47.     set_window_values(integer)
  48.     help_window
  49.     write_regs
  50.     write_reg(integer)
  51.     read_next(string)
  52.     roll_regs_down(integer)
  53.     roll_regs_up(integer)
  54.     exchange_1_2
  55.  
  56. goal
  57.     start.
  58.         
  59. clauses
  60.            
  61.         /* The basic scratchpad memory routines.  */
  62.     remember(Name,Value):-
  63.         asserta(sp(Name,Value)).
  64.         
  65.     forget(Name) :-
  66.         retract(sp(Name,_)).
  67.  
  68.     replace(Name,Value):-
  69.         retract(sp(Name,_)),
  70.         asserta(sp(Name,Value)).
  71.  
  72.     recall(Name,Value) :- sp(Name,Value).
  73.  
  74.  
  75.         /* The calculator engine */        
  76.     /* Note the usage of the state variable to control execution.
  77.        Taken together, process and action constitute a simple ATN --
  78.        Augmented Transition Network.  */
  79.  
  80.     start:- forget(state),fail.
  81.     start:-
  82.         set_up_calc,
  83.         write_regs,
  84.         remember(state,1),
  85.         remember(last_char,0),
  86.         process.
  87.  
  88.     process:-
  89.         recall(state,State),
  90.         State=3,!.
  91.  
  92.     process:-
  93.         read_next(Instring),
  94.         recall(state,State),
  95.         action(State,Instring,""),
  96.         process.
  97.  
  98.  
  99.     read_next(Instring):-
  100.         readchar(Inchar),
  101.         str_char(Instring,Inchar),
  102.         write(Instring).
  103.  
  104.     /* These first few action predicates are responsible for reading in
  105.        numeric entries.  Entries are terminated by an =, CR, or an
  106.        operation.  When readchar reads -- where is it reading from?
  107.        It is not window One.  I'll show you later.             */
  108.        
  109.  
  110.     action(1,String,_):-
  111.         str_int(String,No),
  112.         No>=0,No<=9,
  113.         roll_regs_up(4),
  114.         replace("1",No),
  115.         write_regs,
  116.         replace(state,2),
  117.         read_next(Instring),
  118.         action(2,Instring,String).
  119.         
  120.         
  121.     action(2,String,Buffer1):-
  122.         str_int(String,No),
  123.         No>=0,No<=9,
  124.         concat(Buffer1,String,Buffer2),
  125.         str_real(Buffer2,Value),
  126.         replace("1",Value),
  127.         write_reg(1),
  128.         read_next(Instring),
  129.         action(2,Instring,Buffer2).
  130.  
  131.     /*         Decimal Points, anyone?            */
  132.     action(2,String,Buffer1):-
  133.         String=".",
  134.         concat(Buffer1,String,Buffer2),
  135.         str_real(Buffer2,Value),
  136.         replace("1",Value),
  137.         write_reg(1),
  138.         read_next(Instring),
  139.         action(2,Instring,Buffer2).        
  140.  
  141.     /*        How about elementary operators        */
  142.     /*    (Where is Turbo Prolog's ^ operator?        */
  143.     action(_,String,_):-
  144.         String="+",
  145.         recall("1",X),
  146.         recall("2",Y),
  147.         Z=X+Y,
  148.         replace("1",Z),
  149.         roll_regs_down(2),
  150.         write_regs,
  151.         replace(state,1),!.
  152.         
  153.     action(_,String,_):-
  154.         String="-",
  155.         recall("1",X),
  156.         recall("2",Y),
  157.         Z=Y-X,
  158.         replace("1",Z),
  159.         roll_regs_down(2),
  160.         write_regs,
  161.         replace(state,1),!.
  162.  
  163.     action(_,String,_):-
  164.         String="*",
  165.         recall("1",X),
  166.         recall("2",Y),
  167.         Z=X*Y,
  168.         replace("1",Z),
  169.         roll_regs_down(2),
  170.         write_regs,
  171.         replace(state,1),!.    
  172.  
  173.     action(_,String,_):-
  174.         String="/",
  175.         recall("1",X),
  176.         recall("2",Y),
  177.         Z=Y/X,
  178.         replace("1",Z),
  179.         roll_regs_down(2),
  180.         write_regs,
  181.         replace(state,1),!.
  182.  
  183.  
  184.     action(_,String,_):-
  185.         String="=",
  186.         replace(state,1),!.
  187.         
  188.     action(_,String,_):-
  189.         String="\13",
  190.         replace(state,1),!.        
  191.  
  192.     /*     Swaps registers one and two.  Handy.    */
  193.     action(_,String,_):- String="e",exchange_1_2.
  194.     action(_,String,_):- String="E",exchange_1_2.
  195.  
  196.     /*    Roll registers down.  Also provides a Clear Entry Function. */
  197.     action(_,String,_):-
  198.         String="d",
  199.         roll_regs_down(1),
  200.         write_regs,
  201.         replace(state,1),!.
  202.  
  203.     action(_,String,_):-
  204.         String="D",
  205.         roll_regs_down(1),
  206.         write_regs,
  207.         replace(state,1),!.
  208.  
  209.     /*    What goes down must come up!            */
  210.     action(_,String,_):- 
  211.         String="u",
  212.         roll_regs_up(4),
  213.         write_regs,
  214.         replace(state,1),!.
  215.     action(_,String,_):- 
  216.         String="U",
  217.         roll_regs_up(4),
  218.         write_regs,
  219.         replace(state,1),!.
  220.         
  221.     /* Aha - the function keys
  222.          059 ==> F1
  223.          060 ==> F2
  224.          061 ==> F3, etc.                */
  225.  
  226.     /*Problem 1:  On my system, I can't trap F3 as written here.
  227.               Does it work on your system?  Why or Why Not?
  228.               Have you noticed that if you use the prompt
  229.               statement to redefine function keys in association
  230.               with ANSI.SYS in Dos, that Turbo Prolog does not
  231.               mask these definitions on entry?
  232.       Problem 2:  Why does the error indicator beep when a function
  233.               key is depressed?                    */
  234.  
  235.     action(_,String,_):- 
  236.         String="\59",
  237.         /* F1 ==> Sqrt */
  238.         recall("1",Value),
  239.         NewValue=sqrt(Value),
  240.         replace("1",NewValue),
  241.         write_regs,
  242.         replace(state,1),!.
  243.         
  244.         
  245.     action(_,String,_):- 
  246.         String="\60",
  247.         /* F2 ==> ln */
  248.         recall("1",Value),
  249.         NewValue=ln(Value),
  250.         replace("1",NewValue),
  251.         write_regs,
  252.         replace(state,1),!.
  253.  
  254.     action(_,String,_):- 
  255.         String="\61",
  256.         /* F3 ==> exp */
  257.         recall("1",Value),
  258.         NewValue=exp(Value),
  259.         replace("1",NewValue),
  260.         write_regs,
  261.         replace(state,1),!.
  262.         
  263.     /* The way out */
  264.  
  265.     action(_,String,_):-
  266.         String="q",
  267.         replace(state,3),!.
  268.     action(_,String,_):-
  269.         String="Q",
  270.         replace(state,3),!.        
  271.  
  272.     /*  Notify about bad key presses.  Also guarantees a true
  273.         true evaluation at the end of any action string.      */
  274.     action(_,_,Buffer):-!,
  275.         sound(1,3000),
  276.         recall(state,State),
  277.         read_next(Instring),
  278.         action(State,Instring,Buffer).    
  279.             
  280.     /*   Looks simple enough  */
  281.     write_regs:-
  282.         write_reg(1),write_reg(2),write_reg(3),write_reg(4).
  283.                 
  284.     write_reg(No) :- 
  285.         str_int(Reg,No),
  286.         recall(Reg,Value),
  287.         shiftwindow(No),
  288.         nl,
  289.         write(Value),
  290.         shiftwindow(5).
  291.     /*   What is window 5? Why do we keep going back to it? */
  292.  
  293.     /*   Whee!!!! I'm recursive!  */
  294.     roll_regs_up(0):-
  295.         replace("1",0),!.
  296.     roll_regs_up(No) :-
  297.         str_int(Reg,No),
  298.         recall(Reg,Value),
  299.         RegUpNo=No+1,
  300.         str_int(RegUp,RegUpNo),
  301.         replace(RegUp,Value),
  302.         NextReg=No-1,
  303.         roll_regs_up(NextReg).
  304.         
  305.     /*   Big deal.  So am I.     */
  306.     roll_regs_down(5):-!.
  307.     roll_regs_down(No) :-
  308.         str_int(Reg,No),
  309.         RegDnNo=No+1,
  310.         str_int(RegDn,RegDnNo),
  311.         recall(RegDn,Value),
  312.         replace(Reg,Value),
  313.         NextReg=No+1,
  314.         roll_regs_down(NextReg).
  315.  
  316.  
  317.     /*   No mysteries here.   */
  318.     exchange_1_2:-
  319.         recall("1",X),
  320.         recall("2",Y),
  321.         replace("1",Y),
  322.         replace("2",X),
  323.         write_regs,
  324.         replace(state,1),!.
  325.  
  326.  
  327.  
  328.     /*    Defines the calculators windows.  Note the attribute definition
  329.           of Window 5    */
  330.     set_up_calc :-
  331.         makewindow(8,17,33,"",0,0,25,80),
  332.         makewindow(7,18,33,"Calculator Functions",2,41,14,35),
  333.         help_window,
  334.         makewindow(6,18,33,"Turbo Prolog Calculator",2,3,16,35),
  335.         makewindow(1,33,18,"One",13,6,3,29),
  336.         makewindow(2,33,18,"Two",10,6,3,29),
  337.         makewindow(3,33,18,"Three",7,6,3,29),
  338.         makewindow(4,33,18,"Four",4,6,3,29),
  339.         makewindow(5,17,17,"Invisible Window",17,41,3,25),
  340.         set_window_values(1),
  341.         set_window_values(2),
  342.         set_window_values(3),
  343.         set_window_values(4),
  344.         remember("5",0.00).        
  345.  
  346.         set_window_values(No) :-str_int(Reg,No),recall(Reg,_),!.
  347.         set_window_values(No) :-str_int(Reg,No),remember(Reg,0).
  348.  
  349.     /*  You could make this a pop-up feature.  Actually, why not pop up
  350.         the calculator in the midst of your program as needed?  Are you
  351.         ready for the Turbo Desktop Environment?  Not that I would 
  352.         abandon my trusty Sidekick!                    */
  353.  
  354.     help_window :-
  355.         cursor(1,1),write("Operators"),cursor(1,12),write("Function"),
  356.         cursor(2,1),write("+ - * /"),cursor(2,12),write("Math Operators"),
  357.         cursor(3,1),write("E"),cursor(3,12),write("Exchange 1<-->2"),
  358.         cursor(4,1),write("U"),cursor(4,12),write("Roll Registers Up"),
  359.         cursor(5,1),write("D"),cursor(5,12),write("Roll Registers Down"),
  360.         cursor(6,1),write("Q"),cursor(6,12),write("Quit"),
  361.         cursor(8,1),write("F1"),cursor(8,12),write("Square Root"),
  362.         cursor(9,1),write("F2"),cursor(9,12),write("Ln One"),
  363.         cursor(10,1),write("F3"),cursor(10,12),write("e^One").
  364.     
  365.